home *** CD-ROM | disk | FTP | other *** search
/ Nebula 1 / Nebula One.iso / Internet / WWW / Perl_WWW_Utilities / perlMIF_beta2 / mif / mif_edc.pl < prev    next >
Encoding:
Perl Script  |  1994-06-05  |  16.0 KB  |  505 lines
  1. ##---------------------------------------------------------------------------##
  2. ##  File:
  3. ##      mif_edc.pl
  4. ##  Author:
  5. ##      Earl Hood       ehood@convex.com
  6. ##  Description:
  7. ##    This file is defines the "mif_edc" perl package.  It defines routines
  8. ##    to handle the ElementDefCatalog via MIFread_mif() defined in the
  9. ##    "mif" package.
  10. ##---------------------------------------------------------------------------##
  11. ##  Copyright (C) 1994  Earl Hood, ehood@convex.com
  12. ##
  13. ##  This program is free software; you can redistribute it and/or modify
  14. ##  it under the terms of the GNU General Public License as published by
  15. ##  the Free Software Foundation; either version 2 of the License, or
  16. ##  (at your option) any later version.
  17. ## 
  18. ##  This program is distributed in the hope that it will be useful,
  19. ##  but WITHOUT ANY WARRANTY; without even the implied warranty of
  20. ##  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21. ##  GNU General Public License for more details.
  22. ##  
  23. ##  You should have received a copy of the GNU General Public License
  24. ##  along with this program; if not, write to the Free Software
  25. ##  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  26. ##---------------------------------------------------------------------------##
  27.  
  28. require 'mif/mif.pl' || die "Unable to require mif.pl\n";
  29.  
  30. package mif_edc;
  31.  
  32. $VERSION = "1.0.0";
  33.  
  34. ##-------------------------------------------------##
  35. ## Add Element Catalog function to %MIFToken array ##
  36. ##-------------------------------------------------##
  37. $mif'MIFToken{'ElementDefCatalog'} = 'ElementDefCatalog';
  38.  
  39. ##------------------------------------##
  40. ## Element Catalog Associative Arrays ##
  41. ##------------------------------------##
  42. %EDComments    = ();    # Comments
  43. %EDObject    = ();    # Formatter object represented by the element
  44. %EDHighLevel    = ();    # Can element be highest element in flow
  45. %EDGenRule    = ();    # Content rules
  46. %EDInclusions    = ();    # Included elements (Separated by $edc_or)
  47. %EDExclusions    = ();    # Excluded elements (Separated by $edc_or)
  48. %EDFmtRules    = ();    # Formatting properties (Stored MIF)
  49.  
  50.  
  51. $edc_sep    = ',';
  52. $edc_sep_e    = ',';
  53. $edc_seq    = ',';
  54. $edc_seq_e    = ',';
  55. $edc_or        = '|';
  56. $edc_or_e    = '\|';
  57. $edc_and    = '&';
  58. $edc_and_e    = '&';
  59.  
  60. $edc_grpo    = '(';
  61. $edc_grpo_e    = '\(';
  62. $edc_grpc    = ')';
  63. $edc_grpc_e    = '\)';
  64.  
  65. $edc_plus    = '+';
  66. $edc_plus_e    = '\+';
  67. $edc_opt    = '?';
  68. $edc_opt_e    = '\?';
  69. $edc_rep    = '*';
  70. $edc_rep_e    = '\*';
  71.  
  72. $MStore        = $mif'MStore;
  73. $MOpen        = $mif'MOpen;
  74. $MClose        = $mif'MClose;
  75. $MLine        = $mif'MLine;
  76. $mso        = $mif'mso;
  77. $msc        = $mif'msc;
  78. $stb        = $mif'stb;
  79. $ste        = $mif'ste;
  80. $como        = $mif'como;
  81.  
  82. $elem_keywords    = '<ANY\\\?>|<TEXT\\\?>|<TEXTONLY\\\?>';
  83. $elem_spchars    = "$edc_seq_e$edc_or_e$edc_and_e$edc_grpo_e$edc_grpc_e".
  84.           "$edc_plus_e$edc_opt_e$edc_rep_e$mso$msc".
  85.           '\[\]%';
  86. $model_chars    = "$edc_seq_e$edc_or_e$edc_and_e$edc_grpo_e$edc_grpc_e".
  87.           "$edc_plus_e$edc_opt_e$edc_rep_e";
  88. $grp_chars    = "$edc_grpo_e$edc_grpc_e";
  89. $oi_chars    = "$edc_plus_e$edc_opt_e$edc_rep_e";
  90.  
  91. %EmptyRule = (
  92.     'EDAFrame', 1,
  93.     'EDContainer', 0,
  94.     'EDEmpty', 1,
  95.     'EDEmptyPgf', 1,
  96.     'EDEquation', 0,
  97.     'EDImportedObject', 0,
  98.     'EDMarker', 1,
  99.     'EDTable', 1,
  100.     'EDVariable', 1,
  101.     'EDXRef', 1,
  102. );
  103.  
  104. ##------------------------------------------##
  105. ## Variables for current element definition ##
  106. ##------------------------------------------##
  107. $edc_Com    = "";
  108. $edc_FRules    = "";
  109. $edc_GRule    = "";
  110. $edc_High    = "";
  111. $edc_Object    = "";
  112. $edc_Tag    = "";
  113. @edc_Exc    = ();
  114. @edc_Inc    = ();
  115.  
  116. ##---------------------------------------------------------------------------##
  117.                 ##---------------##
  118.                 ## Main Routines ##
  119.                 ##---------------##
  120. ##---------------------------------------------------------------------------
  121. ##    MIFwrite_edc() outputs the element catalog in MIF as defined by the
  122. ##    above associative array.
  123. ##
  124. ##    Usage:
  125. ##        &'MIFwrite_edc(FILEHANDLE);
  126. ##
  127. sub main'MIFwrite_edc {
  128.     local($handle, $l) = @_;
  129.     local(@array);
  130.     local($i0, $i1, $i2, $i3) =
  131.     (" " x $l, " " x (1+$l), " " x (2+$l), " " x (3+$l));
  132.  
  133.     print $handle $i0, $mso, "ElementDefCatalog\n";
  134.     foreach (sort keys %EDObject) {
  135.     print $handle $i1, $mso, "ElementDef\n";
  136.     print $handle $i2, $mso, "EDTag ", $stb, $_, $ste, $msc, "\n";
  137.     print $handle $i2, $mso, "EDObject ", $EDObject{$_}, $msc, "\n";
  138.     print $handle $i2, $mso, "EDValidHighestLevel ", $EDHighLevel{$_},
  139.                $msc, "\n";
  140.     print $handle $i2, $mso, "EDGeneralRule ", $stb, $EDGenRule{$_}, $ste,
  141.                $msc, "\n" if $EDGenRule{$_};
  142.  
  143.     @array = split(/$edc_or_e/, $EDExclusions{$_});
  144.     if ($#array >= 0) {
  145.         print $handle $i2, $mso, "EDExclusions\n";
  146.         foreach (@array) {
  147.         print $handle $i3, $mso, "Exclusion ",
  148.                    $stb, $_, $ste, $msc, "\n";
  149.         }
  150.         print $handle $i2, $msc, " $como end of EDExclusions\n";
  151.     }
  152.     @array = split(/$edc_or_e/, $EDInclusions{$_});
  153.     if ($#array >= 0) {
  154.         print $handle $i2, $mso, "EDInclusions\n";
  155.         foreach (@array) {
  156.         print $handle $i3, $mso, "Inclusion ",
  157.                    $stb, $_, $ste, $msc, "\n";
  158.         }
  159.         print $handle $i2, $msc, " $como end of EDInclusions\n";
  160.     }
  161.     print $handle $EDFmtRules{$_};
  162.     print $handle $i1, $msc, " $como end of ElementDef\n";
  163.     }
  164.     print $handle " " x $l, $msc, " $como end of ElementDefCatalog\n";
  165. }
  166. ##---------------------------------------------------------------------------##
  167. ##    MIFget_element_data() gets the data of the Frame element $element.
  168. ##
  169. ##    Usage:
  170. ##        ($comments, $object, $highest, $genrule, $inc, $exc) =
  171. ##        &'MIFget_element_data($element);
  172. ##
  173. ##    Note: $inc and $exc is a string of element names separated by
  174. ##          the '|' character.
  175. ##
  176. sub main'MIFget_element_data {
  177.     local($element) = @_;
  178.     ($EDComments{$element},
  179.      $EDObject{$element},
  180.      $EDHighLevel{$element},
  181.      $EDGenRule{$element},
  182.      $EDInclusions{$element},
  183.      $EDExclusions{$element});
  184. }
  185. ##---------------------------------------------------------------------------##
  186. ##    MIFget_elements() returns a sorted array of element names defined
  187. ##    in the element catalog.
  188. ##
  189. ##    Usage:
  190. ##        @elements = &'MIFget_elements();
  191. ##
  192. sub main'MIFget_elements {
  193.     return sort keys %EDObject;
  194. }
  195. ##---------------------------------------------------------------------------##
  196. ##    MIFget_top_elements() retrieves the top-most elements in the
  197. ##    element catalog.
  198. ##
  199. sub main'MIFget_top_elements {
  200.     &compute_parents() unless defined(%Parents);
  201.     return sort keys %TopElement;
  202. }
  203. ##---------------------------------------------------------------------------##
  204. ##    MIFget_parents() returns an array of elements that can be parent
  205. ##    elements of $elem.
  206. ##
  207. sub main'MIFget_parents {
  208.     local($elem) = shift;
  209.     &compute_parents() unless defined(%Parents);
  210.     return sort split(/$edc_sep_e/o, $Parents{$elem});
  211. }
  212. ##---------------------------------------------------------------------------##
  213. ##      MIFget_gen_children() returns an array of the elements in
  214. ##      the general rule of $elem.
  215. ##
  216. ##      The $andcon is flag if the connector characters are included
  217. ##      in the array. (NULL or whitespace strings may be in returned array).
  218. ##
  219. sub main'MIFget_gen_children {
  220.     local($elem, $andcon) = @_;
  221.     return &extract_elem_names($EDGenRule{$elem}, $andcon);
  222. }
  223. ##---------------------------------------------------------------------------##
  224. ##      MIFget_inc_children() returns an array of the elements in
  225. ##      the inclusion group.
  226. ##
  227. sub main'MIFget_inc_children {
  228.     local($elem, $andcon) = @_;
  229.     return &extract_elem_names($EDInclusions{$elem}, $andcon);
  230. }
  231. ##---------------------------------------------------------------------------##
  232. ##      MIFget_exc_children() returns an array of the elements in
  233. ##      the exclusion group.
  234. ##
  235. sub main'MIFget_exc_children {
  236.     local($elem, $andcon) = @_;
  237.     return &extract_elem_names($EDExclusions{$elem}, $andcon);
  238. }
  239. ##---------------------------------------------------------------------------##
  240. ##      MIFis_elem_keyword() returns 1 if $word is an MIF reserved word
  241. ##      used in an element content rule.
  242. ##
  243. sub main'MIFis_elem_keyword {
  244.     local($word) = shift;
  245.     ($word =~ /^\s*($elem_keywords)\s*$/oi ? 1 : 0);
  246. }
  247. ##---------------------------------------------------------------------------##
  248. ##    MIFis_elem_high() returns 1 if $elem can be the highest element
  249. ##    in a Frame document.
  250. ##
  251. sub main'MIFis_elem_high {
  252.     local($elem) = shift;
  253.     ($EDHighLevel{$elem} =~ /^\s*yes\s*/i ? 1 : 0);
  254. }
  255. ##---------------------------------------------------------------------------##
  256. ##    MIFis_elem_empty_rule() returns 1 if $elem has an empty general
  257. ##    rule.
  258. ##
  259. sub main'MIFis_elem_empty_rule {
  260.     local($elem) = shift;
  261.     local($type) = ($EDObject{$elem});
  262.     $type =~ s/^\s*(.*[^\s])\s*$/\1/;
  263.     ($EmptyRule{$type} ? 1 : 0);
  264. }
  265. ##---------------------------------------------------------------------------##
  266. ##    MIFis_occur_indicator() returns 1 if $str is an occurance
  267. ##    indicator.
  268. ##
  269. sub main'MIFis_occur_indicator {
  270.     local($str) = shift;
  271.     ($str =~ /^\s*[$edc_plus_e$edc_opt_e$edc_rep_e]\s*$/oi ? 1 : 0);
  272. }
  273. ##---------------------------------------------------------------------------
  274. ##    MIFis_group_connector() returns 1 if $str is a group connector
  275. ##
  276. sub main'MIFis_group_connector {
  277.     local($str) = shift;
  278.     ($str =~ /^\s*[$edc_seq_e$edc_and_e$edc_or_e]\s*$/oi ? 1 : 0);
  279. }
  280. ##---------------------------------------------------------------------------##
  281. ##    MIFis_elem_name() returns 1 if $str is a legal element name.
  282. ##
  283. sub main'MIFis_elem_name {
  284.     local($str) = shift;
  285.     ($str !~ /^\s*[$elem_spchars]\s*$/oi ? 1 : 0);
  286. }
  287. ##---------------------------------------------------------------------------##
  288. ##      MIFreset_edc() resets the associative arrays for the element
  289. ##      catalog.
  290. ##
  291. ##      Usage:
  292. ##          &'MIFreset_edc();
  293. ##
  294. sub main'MIFreset_edc {
  295.     undef %EDComments;
  296.     undef %EDObject;
  297.     undef %EDHighLevel;
  298.     undef %EDGenRule;
  299.     undef %EDInclusions;
  300.     undef %EDExclusions;
  301.     undef %EDFmtRules;
  302.     undef %Parents;
  303.     undef %TopElement;
  304. }
  305. ##---------------------------------------------------------------------------##
  306.                 ##--------------##
  307.                 ## mif Routines ##
  308.                 ##--------------##
  309. ##---------------------------------------------------------------------------
  310. ##      compute_parents() generates the %Parents and %TopElement arrays.
  311. ##
  312. sub compute_parents {
  313.     local($elem, %exec);
  314.  
  315.     foreach $elem (&'MIFget_elements()) {
  316.         foreach (&extract_elem_names($EDExclusions{$elem})) { $exc{$_} = 1; }
  317.         foreach (&extract_elem_names($EDGenRule{$elem})) {
  318.             $Parents{$_} .= ($Parents{$_} ? $edc_sep : '') . $elem
  319.                 unless $exc{$_} || &'MIFis_elem_keyword($_);
  320.         }
  321.         foreach (&extract_elem_names($EDInclusions{$elem})) {
  322.             $Parents{$_} .= ($Parents{$_} ? $edc_sep : '') . $elem
  323.                 unless $exc{$_} || &'MIFis_elem_keyword($_);
  324.         }
  325.         undef %exc;
  326.     }
  327.     foreach (keys %EDGenRule) {
  328.         $TopElement{$_} = 1 if !$Parents{$_} || $Parents{$_} eq $_;
  329.     }
  330.  
  331.     # foreach (sort keys %Parents) {
  332.     # print STDERR $_ , "\n",
  333.              # "\t", $Parents{$_}, "\n";
  334.     # }
  335. }
  336. ##---------------------------------------------------------------------------##
  337. ##      extract_elem_names() extracts just the element names of $str.
  338. ##      An array is returned.  The elements in $str are assumed to be
  339. ##      separated by connectors.
  340. ##
  341. ##      The $andcon is flag if the connector characters are included
  342. ##      in the array.
  343. ##
  344. sub extract_elem_names {
  345.     local($str, $andcon) = @_;
  346.     local(@array);
  347.     if ($andcon) {
  348.         @array = split(/([$model_chars])/o, $str);
  349.     }
  350.     else {
  351.         $str =~ s/[$grp_chars$oi_chars]//go;
  352.         @array = split(/[$edc_seq_e$edc_and_e$edc_or_e]/o, $str);
  353.     }
  354.     grep(s/^\s*(.*[^\s])\s*$/\1/, @array);
  355.     @array;
  356. }
  357. ##---------------------------------------------------------------------------##
  358. ##    The routines definded below are all registered in the %MIFToken         ##
  359. ##    array for use in the read_mif() routine.  There purpose is to         ##
  360. ##    store the information contained in the element catalog.             ##
  361. ##---------------------------------------------------------------------------##
  362. ##---------------------------------------------------------------------------
  363. sub EDComments {
  364.     local($token, $mode, *data) = @_;
  365.     ($edc_Com) = $data =~ /^\s*$stb([^$ste]*)$ste\s*$/o;
  366. }
  367. ##---------------------------------------------------------------------------
  368. sub Exclusion {
  369.     local($token, $mode, *data) = @_;
  370.     local($tmp) = $data =~ /^\s*$stb([^$ste]*)$ste\s*$/o;
  371.     push(@edc_Exc, $tmp);
  372. }
  373. ##---------------------------------------------------------------------------
  374. sub EDExclusions {
  375.     local($token, $mode, *data) = @_;
  376. }
  377. ##---------------------------------------------------------------------------
  378. sub EDFormatRules {
  379.     local($token, $mode, *data) = @_;
  380.     if ($mode == $MClose) {
  381.     $edc_FRules = $data;
  382.     $edc_FRules .= "\n" unless $data =~ /\s*\n$/;
  383.     }
  384. }
  385. ##---------------------------------------------------------------------------
  386. sub EDGeneralRule {
  387.     local($token, $mode, *data) = @_;
  388.     ($edc_GRule) = $data =~ /^\s*$stb([^$ste]*)$ste\s*$/o;
  389. }
  390. ##---------------------------------------------------------------------------
  391. sub Inclusion {
  392.     local($token, $mode, *data) = @_;
  393.     local($tmp) = $data =~ /^\s*$stb([^$ste]*)$ste\s*$/o;
  394.     push(@edc_Inc, $tmp);
  395. }
  396. ##---------------------------------------------------------------------------
  397. sub EDInclusions {
  398.     local($token, $mode, *data) = @_;
  399. }
  400. ##---------------------------------------------------------------------------
  401. sub EDObject {
  402.     local($token, $mode, *data) = @_;
  403.     ($edc_Object) = $data =~ /^\s*(\S*)/;
  404. }
  405. ##---------------------------------------------------------------------------
  406. sub EDTag {
  407.     local($token, $mode, *data) = @_;
  408.     ($edc_Tag) = $data =~ /^\s*$stb([^$ste]*)$ste\s*$/o;
  409. }
  410. ##---------------------------------------------------------------------------
  411. sub EDValidHighestLevel {
  412.     local($token, $mode, *data) = @_;
  413.     ($edc_High) = $data =~ /^\s*(\S*)/;
  414. }
  415. ##---------------------------------------------------------------------------
  416. sub ElementDef {
  417.     local($token, $mode, *data) = @_;
  418.     if ($mode == $MOpen) {
  419.     $edc_Com = "";
  420.     $edc_FRules = "";
  421.     $edc_GRule = "";
  422.     $edc_High = "";
  423.     $edc_Object = "";
  424.     $edc_Tag = "";
  425.     @edc_Exc = ();
  426.     @edc_Inc = ();
  427.     } elsif ($mode == $MClose) {
  428.     $EDComment{$edc_Tag} = $edc_Com;
  429.     $EDObject{$edc_Tag} = $edc_Object;
  430.     $EDHighLevel{$edc_Tag} = $edc_High;
  431.     $EDGenRule{$edc_Tag} = $edc_GRule;
  432.     $EDInclusions{$edc_Tag} = join($edc_or, @edc_Inc);
  433.     $EDExclusions{$edc_Tag} = join($edc_or, @edc_Exc);
  434.     $EDFmtRules{$edc_Tag} = $edc_FRules;
  435.     } else {
  436.     warn "Unexpected mode, $mode, passed to ElementDef function\n";
  437.     }
  438. }
  439. ##---------------------------------------------------------------------------
  440. ##    ElementDefCatalog() is the token function for "ElementDefCatalog".
  441. ##    It sets/restores token functions depending upon mode.
  442. ##
  443. sub mif'ElementDefCatalog {
  444.     local($token, $mode, *data) = @_;
  445.     if ($mode == $MOpen) {
  446.     ($_fast, $_noidata) = ($mif'fast, $mif'no_import_data);
  447.     ($mif'fast, $mif'no_import_data) = (1, 1);
  448.     @_ed_orgfunc = @mif'MIFToken{
  449.                 'EDComments',
  450.                 'Exclusion',
  451.                 'EDExclusions',
  452.                 'EDFormatRules',
  453.                 'EDGeneralRule',
  454.                 'Inclusion',
  455.                 'EDInclusions',
  456.                 'EDObject',
  457.                 'EDTag',
  458.                 'EDValidHighestLevel',
  459.                 'ElementDef'
  460.                 };
  461.     @mif'MIFToken{
  462.         'EDComments',
  463.         'Exclusion',
  464.         'EDExclusions',
  465.         'EDFormatRules',
  466.         'EDGeneralRule',
  467.         'Inclusion',
  468.         'EDInclusions',
  469.         'EDObject',
  470.         'EDTag',
  471.         'EDValidHighestLevel',
  472.         'ElementDef'
  473.     } = (
  474.         "mif_edc'EDComments",
  475.         "mif_edc'Exclusion",
  476.         "mif_edc'EDExclusions",
  477.         "$MStore,mif_edc'EDFormatRules",
  478.         "mif_edc'EDGeneralRule",
  479.         "mif_edc'Inclusion",
  480.         "mif_edc'EDInclusions",
  481.         "mif_edc'EDObject",
  482.         "mif_edc'EDTag",
  483.         "mif_edc'EDValidHighestLevel",
  484.         "mif_edc'ElementDef"
  485.     );
  486.     } elsif ($mode == $MClose) {
  487.     @mif'MIFToken{
  488.         'EDComments',
  489.         'Exclusion',
  490.         'EDExclusions',
  491.         'EDFormatRules',
  492.         'EDGeneralRule',
  493.         'Inclusion',
  494.         'EDInclusions',
  495.         'EDObject',
  496.         'EDTag',
  497.         'EDValidHighestLevel',
  498.         'ElementDef'
  499.     } = @_ed_orgfunc;
  500.         ($mif'fast, $mif'no_import_data) = ($_fast, $_noidata);
  501.     }
  502. }
  503. ##---------------------------------------------------------------------------
  504. 1;
  505.